home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / basic / qbware.exe / FTIME.BAS < prev    next >
Encoding:
BASIC Source File  |  1990-11-30  |  2.8 KB  |  116 lines
  1. DECLARE SUB FlFind (FlSpec$, BYVAL Addr%)
  2. '*****************************************************************************
  3.  
  4. 'Copyright (c) 1987,1988 Marcel Madonna
  5.  
  6. 'FTIME.BAS shows the use of some of the DOS file management services.
  7.  
  8. '
  9. ' ********************* N O T E *************************
  10. '
  11. 'This program cannot be used from the DOS prompt without Microsoft
  12. 'QuickBasic V4.0 and a registered copy of QBWARE.
  13. '
  14. 'To compile it, at the DOS prompt type:
  15.  
  16. '               bc look;
  17. '               link /ex /noe look,,,brun40 qbware;
  18. '               del look.obj
  19. '               del look.map
  20.  
  21. 'To run it fromthe QuickBasic development environment, type:
  22. '
  23. '               qb look /l qbware
  24. '               [Shift] + F5
  25.  
  26. 'To execute FTIME just type "FTIME" at the DOS prompt and this program will
  27. 'change the date and time stamps on each file in the current directory to
  28. 'the current date and time
  29. '
  30. 'This is a pretty simple program - it can be modified to accept a file
  31. 'specification from the command line or to bypass hidden or system files, etc.
  32.  
  33. '*****************************************************************************
  34.  
  35.     OPTION BASE 1
  36.  
  37.     CLS
  38.     PRINT "FTIME - Version 1.0 (C) Copyright 1987,1988 AJM Software"
  39.     LOCATE 3, 1
  40.     PRINT "This program will alter the timestamps on every file"
  41.     PRINT "in this directory"
  42.     PRINT
  43.     PRINT "Enter (Y)es to continue"
  44.     PRINT "...Any other key aborts"
  45.  
  46.     x$ = INKEY$                             'Clear the keyboard buffer
  47.     WHILE x$ <> ""
  48.         x$ = INKEY$
  49.     WEND
  50.  
  51.     x$ = ""
  52.     WHILE x$ = ""
  53.         x$ = INKEY$
  54.     WEND
  55.  
  56.     IF x$ <> "Y" AND x$ <> "y" THEN END
  57.  
  58.     GOTO A5000.Mainline
  59.  
  60. A0500.Dim.Array:
  61.  
  62.     REDIM Dirlist$(Count%)          'Dimension the array fo FLFIND
  63.     FOR x% = 1 TO Count%            'Initialize each element of array
  64.         Dirlist$(x%) = SPACE$(40)       'to 40 blanks
  65.     NEXT
  66.     RETURN
  67.  
  68.  
  69. A1000.Get.Dirlist:
  70.  
  71.     CALL Flcnt(FlSpec$, Count%)     'Get a count of matching files
  72.  
  73.     IF Count% <> 0 THEN
  74.         GOSUB A0500.Dim.Array
  75.         CALL FlFind(FlSpec$, VARPTR(Dirlist$(LBOUND(Dirlist$))))
  76.     END IF
  77.  
  78.     RETURN
  79.  
  80. A5000.Mainline:
  81.  
  82. ' Retrieve current date and time
  83.  
  84.     NFDate$ = DATE$
  85.     NFTime$ = TIME$
  86.  
  87. ' Let's get all files in the current directory
  88.  
  89.     FlSpec$ = "*.*" + CHR$(0)       'Complete file directory
  90.     GOSUB A1000.Get.Dirlist
  91.  
  92.     x% = 1                          'Initialize counter
  93.  
  94.  
  95.     WHILE x% <= Count%
  96.         Xfname$ = MID$(Dirlist$(x%), 28, 12)
  97.         Fattr$ = MID$(Dirlist$(x%), 1, 5)
  98.  
  99. ' We'll exclude directories
  100.  
  101.         IF INSTR(Fattr$, "D") = 0 THEN  'let's exclude directories
  102.             CALL FlPDat(Xfname$ + CHR$(0), NFDate$, NFTime$, Rc%)
  103.             IF Rc% = 0 THEN
  104.                 Tot.files% = Tot.files% + 1
  105.             ELSE
  106.                 PRINT "Error "; Rc%; " on file" + Xfname$
  107.             END IF
  108.         END IF
  109.         x% = x% + 1
  110.     WEND
  111.  
  112.     PRINT Tot.files%; " files updated successfully"
  113.  
  114.     END
  115.  
  116.